M3.FRT[M11,LCS] - www.SailDart.org

perm filename M3.FRT[M11,LCS] blob sn#373984 filedate 1978-11-24 generic text, type T, neo UTF8
CFORS3     FORTRAN UNIT GENERATOR ROUTINE     
C    *** MUSIC V ***     
      SUBROUTINE FORSAM   
      DIMENSION L(8),M(8)     
CC    DIMENSION I(15000),P(100),IP(20),L(8),M(8)     
      COMMON I(1)/P/ P(1)/PARM/IP(1)
CC    COMMONI,P/PARM/IP  
      EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
     1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(  
     2L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(RN1,IRN1),(RN3,IRN3),(RN,I  
     3RN)  
1	FORMAT(1X5F/)
2	FORMAT(1X5I/)
CX	TYPE 2,IP(15),IP(12),IP(6)
	SFXX=FLOAT(IP(15))
CX	TYPE 1,SFXX
      SFID=FLOAT(IP(12)) 
CX	TYPE 1,SFID
      SFI=1./SFID
CX	TYPE 1,SFI
      SFF=1./SFXX      
CX	TYPE 1,SFF
      SFXX=SFID/SFXX 
CX	TYPE 1,SFXX
      XNFUN=IP(6)-1      
CX	TYPE 1,XNFUN
C     COMMON INITIALIZATION OF GENERATORS     
      N1=I(6)+2   
      N2=I(N1-1)-1
CX	PAUSE 'DO 204'
      DO 204 J1=N1,N2      
      J2=J1-N1+1  
	IF(I(J1).GE.0)GO TO 201
CCC   IF(I(J1))200,201,201      
 200  L(J2)=-I(J1)
      M(J2)=1     
      GO TO 204     
 201  M(J2)=0     
	IF(I(J1)-26262.GT.0)GO TO 203
C     IF(I(J1)-26262)202,202,203      
CCC   IF(I(J1)-262144)202,202,203      
C***** WHAT DOES THE BIG NUMBER DO?????
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
 202  L(J2)=I(J1)+I(3)-1 
      GO TO 204     
 203  L(J2)=I(J1)-26262  
CCC 203  L(J2)=I(J1)-262144 
C****** WHAT DOES THIS BIG NUM. DO?? ***********
 204  CONTINUE    
      NSAM=I(5)   
      N3=I(N1-2)  
      NGEN=  N3 -100     
      GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN   
 112  RETURN      
C     UNIT GENERATORS    
C     OUTPUT BOX  
 101  IF(M1.GT.0)GO TO 261  
CCC 101  IF(M1)260,260,261  
 260  IN1=I(L1)   
 261  CONTINUE    
      DO 270 J3=1,NSAM     
      IF(M1.LE.0)GO TO 265
CCC   IF(M1)265,265,264  
 264  J4=L1+J3-1  
      IN1=I(J4)   
 265  J5=L2+J3-1  
      I(J5)=IN1+I(J5)    
 270  CONTINUE    
      RETURN      
C     OSCILLATOR  
 102  SUM=FLOAT(I(L5))*SFI      
CX	PAUSE 'OSC  102'
	IF(M1.GT.0)GO TO 281
CCC   IF(M1)280,280,281  
 280  AMP=FLOAT(I(L1))*SFI      
281	IF(M2.GT.0)GO TO 283
CCC 281  IF(M2)282,282,283  
 282  FREQ=FLOAT(I(L2))*SFI     
 283  CONTINUE    
      DO 293 J3=1,NSAM     
      J4=INT(SUM)+L4     
      F=FLOAT(I(J4))     
	IF(M2.GT.0)GO TO 286
CCC   IF(M2)285,285,286  
 285  SUM=SUM+FREQ
      GO TO 290     
 286  J4=L2+J3-1  
      SUM=SUM+FLOAT(I(J4))*SFI  
CC 290  IF(SUM-XNFUN)288,287,287  
290     IF(SUM.GE.XNFUN)GO TO 287
CC 287  SUM=SUM-XNFUN      
       IF(SUM.LT.0.0)GO TO 289
 288  J5=L3+J3-1  
	IF(M1.GT.0)GO TO 292
CCC   IF(M1)291,291,292  
 291  I(J5)=IFIX(AMP*F*SFXX)    
      GO TO 293     
C**********
287    SUM=SUM-XNFUN
       GO TO 288
289    SUM=SUM+XNFUN
       GO TO 288
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
 292  J6=L1+J3-1  
      I(J5)=IFIX(FLOAT(I(J6))*F*SFF)   
 293  CONTINUE    
      I(L5)=IFIX(SUM*SFID)      
      RETURN      
C     ADD TWO BOX 
103	IF(M1.GT.0)GO TO 251
CCC 103  IF(M1)250,250,251  
 250  IN1=I(L1)   
 251  IF(M2.GT.0)GO TO 253  
CCC 251  IF(M2)252,252,253  
 252  IN2=I(L2)   
 253  DO 258 J3=1,NSAM     
	IF(M1.LE.0)GO TO 255
CCC   IF(M1)255,255,254  
 254  J4=L1+J3-1  
      IN1=I(J4)   
255	IF(M2.LE.0)GO TO 257
CCC 255  IF(M2) 257,257,256 
 256  J5=L2+J3-1  
      IN2=I(J5)   
 257  J6=L3+J3-1  
      I(J6)=IN1+IN2      
 258  CONTINUE    
      RETURN      
C     RANDOM INTERPOLATING GENERATOR   
 104  SUM=FLOAT(I(L4))*SFI      
	IF(M1.GT.0)GO TO 311
CCC   IF(M1)310,310,311  
 310  XIN1=FLOAT(I(L1))*SFI     
311	IF(M2.GT.0)GO TO 313
CCC 311  IF(M2)312,312,313  
 312  XIN2=FLOAT(I(L2))*SFI     
 313  IRN1=I(L5)  
      IRN3=I(L6)  
      DO 340 J3=1,NSAM     
	IF(M1.LE.0)GO TO 316
CCC   IF(M1)316,316,315  
 315  J4=L1+J3-1  
      XIN1=FLOAT(I(J4))*SFI     
316	IF(M2.LE.0)GO TO 318
CCC 316  IF(M2)318,318,317  
 317  J5=L2+J3-1  
      XIN2=FLOAT(I(J5))*SFI     
 318  IF(SUM-XNFUN)320,319,319  
 319  SUM=SUM-XNFUN      
      I(7)=IABS (I(7)*IMULT)    
      RN4=(2.*FLOAT(I(7))*SFF-1.)
      RN2=RN4-RN3 
      RN1=RN3     
      RN3=RN4     
      GO TO 321     
 320  RN2=RN3-RN1 
 321  J7=L3+J3-1  
      I(J7)=XIN1*(RN1+(RN2*SUM)/XNFUN)*SFID   
      SUM=SUM+XIN2
 340  CONTINUE    
      I(L4)=IFIX(SUM*SFID)      
      I(L5)=IRN1  
      I(L6)=IRN3  
      RETURN      
C     ENVELOPE GENERATOR 
 105  SUM=FLOAT(I(L7))*SFI      
	IF(M1.GT.0)GO TO 381
CCC   IF(M1)380,380,381  
 380  XIN1=FLOAT(I(L1))*SFI     
381	IF(M4.GT.0)GO TO 383
CCC 381  IF(M4)382,382,383  
 382  XIN4=FLOAT(I(L4))*SFI     
383	IF(M5.GT.0)GO TO 385
CCC 383  IF(M5)384,384,385  
 384  XIN5=FLOAT(I(L5))*SFI     
385	IF(M6.GT.0)GO TO 387
CCC 385  IF(M6)386,386,387  
 386  XIN6=FLOAT(I(L6))*SFI     
 387  X1=XNFUN/4. 
      X2=2.*X1    
      X3=3.*X1    
      DO 403 J3=1,NSAM     
      J4=INT(SUM)+L2     
      F=FLOAT(I(J4))     
	IF(M1.LE.0)GO TO 405
CCC   IF(M1)405,405,404  
 404  J8=L1+J3-1 
      XIN1=FLOAT(I(J8))*SFI      
405	IF(SUM-XNFUN.LT.0)GO TO 389
CCC 405  IF(SUM-XNFUN)389,388,388   
 388  SUM=SUM-XNFUN      
389	IF(SUM-X1.GT.0)GO TO 393
CCC 389  IF(SUM-X1)390,390,393      
390	IF(M4.LE.0)GO TO 392
CCC 390  IF(M4)392,392,391  
 391  J4=L4+J3-1 
      XIN4=FLOAT(I(J4))*SFI      
 392  SUM=SUM+XIN4       
      GO TO 402    
393	IF(SUM-X2.GT.0)GO TO 397
CCC 393  IF(SUM-X2)394,394,397      
394	IF(M5.LE.0)GO TO 396
CCC 394  IF(M5)396,396,395  
 395  J5=L5+J3-1 
      XIN5=FLOAT(I(J5))*SFI      
 396  SUM=SUM+XIN5       
      GO TO 402    
397	IF(M6.LE.0)GO TO 400
CCC 397  IF(M6)400,400,399  
 399  J6=L6+J3-1 
      XIN6=FLOAT(I(J6))*SFI      
 400  SUM=SUM+XIN6       
 402  J7=L3+J3-1 
      I(J7)=IFIX(XIN1*F*SFXX)    
 403  CONTINUE   
      I(L7)=IFIX(SUM*SFID)       
      RETURN     
C     STEREO OUTPUT BOX  
106	IF(M1.GT.0)GO TO 501
CCC 106  IF(M1)500,500,501  
 500  IN1=I(L1)  
501	IF(M2.GT.0)GO TO 503
CCC 501  IF(M2)502,502,503  
 502  IN2=I(L2)  
 503  NSSAM=2*NSAM       
C  6/29/70  L.C.SMITH
      ICT=0
      DO 510 J3=1,NSSAM,2  
	IF(M1.LE.0)GO TO 505
CCC   IF(M1)505,505,504  
CC*** 504  J4=L1+J3-1 
504   J4=L1+ICT
      IN1=I(J4)  
 505  J5=L3+J3-1 
      I(J5)=IN1+I(J5)    
	IF(M2.LE.0)GO TO 507
CCC   IF(M2)507,507,506  
CC*** 506  J4=L2+J3-1 
506   J4=L2+ICT
      IN2=I(J4)  
 507  J5=L3+J3   
      I(J5)=IN2+I(J5)    
 510  ICT=ICT+1  
      RETURN     
C     ADD 3 BOX  
107	IF(M1.GT.0)GO TO 751
CCC 107  IF(M1)750,750,751  
 750  IN1=I(L1)  
751	IF(M2.GT.0)GO TO 753
CCC 751  IF(M2)752,752,753  
 752  IN2=I(L2)  
753	IF(M3.GT.0)GO TO 755
CCC 753  IF(M3)754,754,755  
 754  IN3=I(L3)  
 755  DO 780 J3=1,NSAM     
	IF(M1.LE.0)GO TO 757
CCC   IF(M1)757,757,756  
 756  J4=L1+J3-1  
      IN1=I(J4)  
757	IF(M2.LE.0)GO TO 759
CCC 757  IF(M2)759,759,758  
 758  J5=L2+J3-1 
      IN2=I(J5)  
759	IF(M3.LE.0)GO TO 761
CCC 759  IF(M3)761,761,760  
 760  J6=L3+J3-1 
      IN3=I(J6)  
 761  J7=L4+J3-1 
      I(J7)=IN1+IN2+IN3  
 780  CONTINUE   
      RETURN     
C     ADD 4 BOX  
 108  IF(M1)850,850,851  
 850  IN1=I(L1)  
 851  IF(M2)852,852,853  
 852  IN2=I(L2)  
 853  IF(M3)854,854,855  
 854  IN3=I(L3)  
 855  IF(M4)856,856,857  
 856  IN4=I(L4)  
 857  DO 880 J3=1,NSAM     
      IF(M1)859,859,858  
 858  J4=L1+J3-1 
      IN1=I(J4)  
 859  IF(M2)861,861,860  
 860  J5=L2+J3-1 
      IN2=I(J5)  
 861  IF(M3)863,863,862  
 862  J6=L3+J3-1 
      IN3=I(J6)  
 863  IF(M4)865,865,864  
 864  J7=L4+J3-1 
      IN4=I(J7)  
 865  J8=L5+J3-1 
      I(J8)=IN1+IN2+IN3+IN4      
 880  CONTINUE   
      RETURN     
C     MULTIPLIER 
 109  IF(M1)900,900,901  
 900  XIN1=FLOAT(I(L1))*SFI      
 901  IF(M2)902,902,903  
 902  XIN2=FLOAT(I(L2))*SFI      
 903  DO 908 J3=1,NSAM     
      IF(M1)905,905,904  
 904  J4=L1+J3-1 
      XIN1=FLOAT(I(J4))*SFI      
 905  IF(M2)907,907,906  
 906  J5=L2+J3-1 
      XIN2=FLOAT(I(J5))*SFI      
 907  J6=L3+J3-1 
      I(J6)=XIN1*XIN2*SFID       
 908  CONTINUE   
      RETURN     
C     SET NEW FUNCTION IN OSC OR ENV     
 110  ILOC=N1+6  
      IF(I(N1+1).EQ.105) ILOC=N1+4 
      IN1=I(3)+I(N1)-1   
      IIN1=I(IN1)/IP(12) 
      IF(IIN1)960,960,955
 955  I(ILOC)=-IP(2)-(IIN1-1)*IP(6)      
 960  RETURN     
C     RANDOM AND HOLD GENERATOR  
 111  SUM=FLOAT(I(L4))*SFI       
      IF(M1)910,910,911  
 910  XIN1=FLOAT(I(L1))*SFI      
 911  IF(M2)912,912,913  
 912  XIN2=FLOAT(I(L2))*SFI      
 913  IRN=I(L5)  
      DO 940 J3=1,NSAM     
      IF(M1)916,916,915  
 915  J4=L1+J3-1 
      XIN1=FLOAT(I(J4))*SFI      
 916  IF(M2)918,918,917  
 917  J5=L2+J3-1 
      XIN2=FLOAT(I(J5))*SFI      
 918  IF(SUM-XNFUN)920,919,919   
 919  SUM=SUM-XNFUN      
      I(7)=IABS (I(7)*IMULT)     
      RN=(2.*FLOAT(I(7))*SFF-1.)
 920  J7=L3+J3-1 
      I(J7)=XIN1*RN*SFID 
      SUM=SUM+XIN2       
 940  CONTINUE   
      I(L4)=IFIX(SUM*SFID)       
      I(L5)=IRN  
      RETURN     
      END